home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / cssEngine.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  25.6 KB  |  794 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  CSS mode - tools for editing CSS documents
  4.  # 
  5.  #  FILE: "cssEngine.tcl"
  6.  #                                    created: 97-03-08 19.32.58 
  7.  #                                last update: 00-12-22 22.39.03 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1997-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains the main procs for handling the CSS property dialogs.
  35. #===============================================================================
  36.  
  37. proc css::FindWhereToInsert {group pos} {
  38.     if {[string index $group 0] == "@"} {css::FindWhereToInsertAtRule $group $pos; return}
  39.     if {$pos > [minPos]} {set pos [pos::math $pos - 1]}
  40.     if {[catch {search -s -f 0 -m 0 -r 1 "\{" $pos} lbrace]} {set lbrace [minPos]; set noleft 1}
  41.     set lbrace [pos::math [lindex $lbrace 0] + 1]
  42.     if {[catch {search -s -f 0 -m 0 -r 1 "\}" $pos} rbrace]} {set rbrace [minPos]}
  43.     set rbrace [pos::math [lindex $rbrace 0] + 1]
  44.     if {[info exists noleft] || [pos::compare $rbrace > $lbrace]} {
  45.         alertnote "Incorrect position to insert properties."
  46.         error "Incorrect position"
  47.     }
  48.     if {[catch {search -s -f 0 -m 0 -r 1 "\;" $pos} semi] || [pos::compare [lindex $semi 0] < $lbrace]} {set semi [minPos]}
  49.     set semi [pos::math [lindex $semi 0] + 1]
  50.     set go $pos
  51.     if {[pos::compare $lbrace > [minPos]] || [pos::compare $semi > [minPos]]} {
  52.         if {[pos::compare $lbrace > $semi]} {
  53.             set go $lbrace
  54.         } else {
  55.             set go $semi
  56.         }
  57.     }
  58.     if {[css::IsInComment $go]} {
  59.         set go [lindex [search -s -f 0 -m 0 -r 0 "/*" $go] 0]
  60.         css::FindWhereToInsert $group $go
  61.     } else {
  62.         goto $go
  63.     }
  64. }
  65.  
  66. proc css::FindWhereToInsertAtRule {atrule pos} {
  67.     switch $atrule {
  68.         @charset {goto [minPos]}
  69.         @import {
  70.             if {![catch {search -s -f 1 -m 0 -r 1 {@charset[^;]+;} [minPos]} res]} {
  71.                 goto [lindex $res 1]
  72.             } else {
  73.                 goto [minPos]
  74.             }
  75.         }
  76.         default {
  77.             if {![catch {matchIt "\}" $pos} res]} {
  78.                 if {[catch {search -s -f 0 -m 0 -r 1 "\}" [pos::math [lindex $res 0] - 1]} rbrace]} {
  79.                     goto [minPos]
  80.                 } else {
  81.                     goto [lindex $rbrace 1]
  82.                 }
  83.             }
  84.         }
  85.     }
  86. }
  87.  
  88. proc css::IsInComment {pos} {
  89.     global css::CommentRegexp
  90.     if {[catch {search -s -f 0 -m 0 -r 1 ${css::CommentRegexp} $pos} res]} {return 0}
  91.     return [pos::compare [lindex $res 1] > $pos]
  92. }
  93.  
  94. proc css::IsInAtRule {atrule} {
  95.     global css::CommentRegexp
  96.     if {[catch {matchIt "\}" [getPos]} p]} {return 0}
  97.     if {[catch {search -s -f 0 -m 0 -r 1 "\}" $p} rbrace]} {set rbrace [minPos]}
  98.     set rbrace [lindex $rbrace end]
  99.     set txt [getText $rbrace $p]
  100.     regsub -all [set css::CommentRegexp] $txt "" txt
  101.     return [regexp -nocase "@$atrule\[ \t\r\n\]*$" $txt]
  102. }
  103.  
  104. proc css::FontFace {} {
  105.     css::FindWhereToInsert @font-face [getPos]
  106.     insertText "[html::OpenCR]@font-face \{\r[text::Tab]\r\}\r"
  107.     goto [pos::math [getPos] - 3]
  108. }
  109.  
  110. # CSS properties dialog
  111. proc css::Dialog {group} {
  112.     global mode css::Property css::UseShort css::InheritAll css::SetAllValues css::Shorthand css::IsDescriptor
  113.     global css::ExtraDialog css::ReadExtraDialog css::AddMissingValues indentationAmount css::Descriptor
  114.     
  115.     if {$mode == "HTML" && ![html::IsInContainer STYLE]} {
  116.         beep
  117.         message "Current position is not inside STYLE tags."
  118.         return
  119.     }
  120.  
  121.     # Find where to insert text.
  122.     set currPos [getPos]
  123.     css::FindWhereToInsert $group $currPos
  124.     
  125.     # Get current properties
  126.     set val {0 0}
  127.     set css::UseShort 1
  128.     set css::InheritAll 0
  129.     set css::SetAllValues 0
  130.     set removePos0 {}
  131.     set removePos1 {}
  132.     if {[string index $group 0] != "@"} {css::GetProperties $group val removePos0 removePos1 important errorText}
  133.     if {[info exists errorText] && ![html::ErrorWindow "$group not well-defined" $errorText 1]} {return}
  134.     
  135.     # The dialog
  136.     set invalidInput 1
  137.     while {$invalidInput} {
  138.         while {1} {
  139.             set htxt "[string toupper [string index $group 0]][string range $group 1 end]"
  140.             if {[string index $group 0] != "@"} {append htxt " properties"}
  141.             set box ""
  142.             if {[info tclversion] < 8.0} {set box "-t [list $htxt] 120 10 450 25"}
  143.             set hpos 35
  144.             set wpos 10
  145.             set index 2
  146.             set buttons ""
  147.             if {${css::IsDescriptor}} {
  148.                 set gprop [set css::Descriptor($group)]
  149.             } else {
  150.                 set gprop [set css::Property($group)]
  151.             }
  152.             # Build the dialog
  153.             eval css::BuildDialog$gprop $group val box hpos wpos buttons buttonAction index
  154.             if {[info tclversion] >= 8.0} {append box " -T [list $htxt]"}
  155.             set val [eval [concat dialog -w 470 -h [expr {$hpos + 50}] \
  156.               -b OK 20 [expr {$hpos + 20}]  85 [expr {$hpos + 40}] \
  157.               -b Cancel 110 [expr {$hpos + 20}] 175 [expr {$hpos + 40}] $box]]
  158.             # Read checkboxes for shorthand groups.
  159.             if {($gprop == "group" || $gprop == "border") && [set css::Shorthand($group)]} {
  160.                 set css::UseShort [lindex $val [expr {[llength $val] - 1}]]
  161.                 set css::InheritAll [lindex $val [expr {[llength $val] - 2}]]
  162.                 # Extra dialog for shorthand groups
  163.                 if {[info exist css::ExtraDialog($group)]} {
  164.                     eval [set css::ReadExtraDialog($group)] val
  165.                 }
  166.             }
  167.             # OK clicked?
  168.             if {[lindex $val 0]} {break}
  169.             # Cancel clicked?
  170.             if {[lindex $val 1]} {goto $currPos; return}
  171.             # Another button clicked
  172.             foreach b $buttons {
  173.                 if {[lindex $val $b]} {eval $buttonAction($b) val $b}
  174.             }
  175.         }
  176.         set index 2
  177.         set proptext ""
  178.         set errtext ""
  179.         # Read dialog
  180.         eval css::ReadDialog$gprop $group val index important proptext errtext
  181.         # Add important for single properties.
  182.         if {$gprop != "group" && [info exists important($group)]} {
  183.             append proptext " ! important"
  184.         }
  185.         if {![llength $errtext]} {
  186.             set invalidInput 0
  187.             # Add missing values automatically
  188.             if {!${css::SetAllValues} && [info exists css::AddMissingValues($group)]} {eval [set css::AddMissingValues($group)] $group proptext}
  189.             # Make shorthand form
  190.             if {${css::UseShort} && [info exists css::Shorthand($group)] && [set css::Shorthand($group)]} {css::MakeShort $group proptext important}
  191.             # Inherit all
  192.             if {${css::InheritAll}} {
  193.                 set proptext ";\r$group: inherit"
  194.             }
  195.         } else {
  196.             html::ErrorWindow "Invalid input" $errtext
  197.         }
  198.     }        
  199.     set proptext [string trimleft $proptext "\;"]
  200.     
  201.     if {[string index $group 0] != "@"} {
  202.         # Find indentation.
  203.         set indent ""
  204.         if {![catch {matchIt "\}" [getPos]} pos]} {
  205.             set indent [text::indentString $pos]
  206.         }
  207.         set indent [text::indentBy "" [expr {[string length [text::maxSpaceForm $indent]] + $indentationAmount}]]
  208.         regsub -all "\r" $proptext "\r$indent" proptext
  209.     } else {
  210.         set proptext [html::OpenCR][string trimleft $proptext]
  211.     }
  212.     set len 0
  213.     set ps [getPos]
  214.     set removePos0 [lsort -command css::posCompare -decreasing $removePos0]
  215.     set removePos1 [lsort -command css::posCompare -decreasing $removePos1]
  216.     # Check for overlapping positions.
  217.     set r0 [maxPos]
  218.     for {set i 0} {$i < [llength $removePos1]} {incr i} {
  219.         set r00 [lindex $removePos0 $i]
  220.         set r11 [lindex $removePos1 $i]
  221.         if {[pos::compare $r11 > $r0]} {set r11 $r0}
  222.         if {[pos::compare $r11 > $r00]} {lappend rem [list $r00 $r11]}
  223.         set r0 $r00
  224.     }
  225.     if {[info exists rem]} {
  226.         set hasinserted 0
  227.         foreach r $rem {
  228.             set xpos 0
  229.             if {!$hasinserted && [pos::compare [lindex $r 0] < $ps]} {
  230.                 css::insertPropText $group $proptext
  231.                 set hasinserted 1
  232.             }
  233.             deleteText [lindex $r 0] [lindex $r 1]
  234.         }
  235.         if {!$hasinserted} {css::insertPropText $group $proptext}
  236.     } else {
  237.         css::insertPropText $group $proptext
  238.     }        
  239. }
  240.  
  241. proc css::insertPropText {group proptext} {
  242.     if {![is::Whitespace $proptext]} {
  243.         if {$group != "@media" && $group != "@page"} {
  244.             append proptext ";"
  245.         } else {
  246.             append proptext " \{\r[text::Tab]\r\}\r"
  247.         } 
  248.         insertText "$proptext"
  249.         set len [string length $proptext]
  250.         if {$group == "@media" || $group == "@page"} {
  251.             goto [pos::math [getPos] - 3]
  252.         }
  253.     }
  254. }
  255.  
  256. proc css::posCompare {p1 p2} {
  257.     if {[pos::compare $p1 < $p2]} {
  258.         return -1
  259.     } else {
  260.         return [pos::compare $p1 != $p2]
  261.     }
  262. }
  263.  
  264. proc css::QuoteValue {v} {
  265.     if {![regexp {^("[^"]+"|'[^']+')$} $v]} {
  266.         if {[regexp {"} $v]} {set v "'$v'"} else {set v "\"$v\""}
  267.     }
  268.     return $v
  269. }
  270.  
  271. # Add missing values to top, right, bottom, left properties.
  272. proc css::AddMissingVals {group ptext} {
  273.     upvar $ptext proptext
  274.     global css::Group
  275.     set text $proptext
  276.     set tmp [split $text "\r"]
  277.     set sideList {top right bottom left}
  278.     # Find those values which have been set
  279.     foreach side $sideList {
  280.         set $side 0
  281.         foreach l $tmp {
  282.             if {[string match *${side}* [lindex $l 0]]} {
  283.                 set $side 1
  284.                 set ${side}val [string trimright [lindex $l 1] "\;"]
  285.             }
  286.         }
  287.     }
  288.     # Add missing values.
  289.     foreach side $sideList {
  290.         if {![set $side]} {
  291.             switch $side {
  292.                 top {set opside bottom}
  293.                 right {set opside left}
  294.                 bottom {set opside top}
  295.                 left {set opside right}
  296.             }
  297.             if {[set $opside]} {
  298.                 set use $opside
  299.             } elseif {$top} {
  300.                 set use top
  301.             } else {
  302.                 # Can't add missing value.
  303.                 return
  304.             }    
  305.             append text "\;\r[lindex [set css::Group($group)] [lsearch $sideList $side]]: [set ${use}val]"
  306.         }
  307.     }
  308.     set proptext $text
  309. }
  310.  
  311. #===============================================================================
  312. # ◊◊◊◊ Making short form properties ◊◊◊◊ #
  313. #===============================================================================
  314.  
  315. proc css::MakeShort {group p im} {
  316.     upvar $p proptext $im important
  317.     global css::Group css::MakeShort
  318.     # don't make short if only some properties are important
  319.     if {[info exists important] && [llength [set css::Group($group)]] > 
  320.     [expr {[llength [array names important]] - [info exists important($group)]}]} {return}
  321.     
  322.     set lines [split $proptext \r]
  323.     foreach l [lrange $lines 1 end] {
  324.         regsub { ! important} $l "" l
  325.         regexp {^([^:]+):[ ]*([^;]+)} $l "" pr v
  326.         set propvalue($pr) $v
  327.     }
  328.     # don't make short if some are inherited
  329.     foreach pr [array names propvalue] {
  330.         if {$propvalue($pr) == "inherit"} {return}
  331.     }
  332.     if {[info exists propvalue]} {
  333.         eval [set css::MakeShort($group)] $group proptext propvalue important
  334.     }
  335. }
  336.  
  337. proc css::MakeShort4lengths {group pt pv im} {
  338.     upvar $pt proptext $pv propvalue $im important
  339.     if {[llength [array names propvalue]] != 4} {return}
  340.     
  341.     foreach side {top right bottom left} {
  342.         foreach p [array names propvalue] {
  343.             if {[string match "*$side*" $p]} {lappend values $propvalue($p)}
  344.         }
  345.     }
  346.     
  347.     if {[llength [lunique $values]] == 1} {
  348.         set values [lindex $values 0]
  349.     } elseif {[lindex $values 0] == [lindex $values 2] && [lindex $values 1] == [lindex $values 3]} {
  350.         set values [lrange $values 0 1]
  351.     } elseif {[lindex $values 1] == [lindex $values 3]} {
  352.         set values [lrange $values 0 2]
  353.     }
  354.     set proptext ";\r$group: $values"
  355.     if {[info exists important]} {append proptext " ! important"}
  356. }
  357.  
  358. proc css::MakeShortPile {group pt pv im} {
  359.     upvar $pt proptext $pv propvalue $im important
  360.     set ptext ";\r$group:"
  361.     set inherit 0
  362.     foreach p [array names propvalue] {
  363.         append ptext " " $propvalue($p)
  364.         if {$propvalue($p) == "inherit"} {incr inherit}
  365.     }
  366.     if {$inherit} {
  367.         if {$inherit == [llength [array names propvalue]]} {
  368.             set ptext ";\r$group: inherit"
  369.         } else {
  370.             return
  371.         }
  372.     }
  373.     if {[info exists important]} {append ptext " ! important"}
  374.     set proptext $ptext
  375. }
  376.  
  377. proc css::MakeShortPileIfBoth {group pt pv im} {
  378.     upvar $pt proptext $pv propvalue $im important
  379.     if {[llength [set n [lsort [array names propvalue]]]] == 2} {
  380.         set v [array get propvalue]
  381.         if {[lindex $v 1] != [lindex $v 3]} {
  382.             set propvalue([lindex $n 0]) [concat $propvalue([lindex $n 1]) $propvalue([lindex $n 0])]
  383.         }
  384.         unset propvalue([lindex $n 1])
  385.         css::MakeShortPile $group proptext propvalue important
  386.     }
  387. }
  388.  
  389. proc css::MakeShortFont {group pt pv im} {
  390.     upvar $pt proptext $pv propvalue $im important
  391.     if {![info exists propvalue(font-size)] || ![info exists propvalue(font-family)]} {return}
  392.     set ptext ";\r$group:"
  393.     set inherit 0
  394.     foreach p [array names propvalue] {
  395.         if {$propvalue($p) == "inherit"} {incr inherit}
  396.         if {$p == "font-family"} {continue}
  397.         if {$p == "line-height"} {
  398.             append ptext " " $propvalue(font-size) "/" $propvalue($p)
  399.             continue
  400.         }
  401.         if {$p != "font-size" || ![info exists propvalue(line-height)]} {
  402.             append ptext " " $propvalue($p)
  403.         }
  404.     }
  405.     append ptext " " $propvalue(font-family)
  406.     if {$inherit} {
  407.         if {$inherit == [llength [array names propvalue]]} {
  408.             set ptext ";\r$group: inherit"
  409.         } else {
  410.             return
  411.         }
  412.     }
  413.     if {[info exists important]} {append ptext " ! important"}
  414.     set proptext $ptext
  415. }
  416.  
  417. #===============================================================================
  418. # ◊◊◊◊ Expanding short form properties ◊◊◊◊ #
  419. #===============================================================================
  420.  
  421. proc css::ExpandPile {group value pv err {ignore ""}} {
  422.     upvar $pv prop $err errorText
  423.     global css::Group css::Property
  424.     foreach p [set css::Group($group)] {
  425.         if {[lcontains ignore $p]} {continue}
  426.         for {set i 0} {$i < [llength $value]} {incr i} {
  427.             set v [lindex $value $i]
  428.             set val ""
  429.             eval css::GetProperties[set css::Property($p)] $p v val
  430.             set index 0
  431.             set propvalue ""
  432.             eval css::ReadDialog[set css::Property($p)] $p val index important propvalue errtext
  433.             if {$propvalue != ""} {
  434.                 regsub ";\r$p: " $propvalue "" propvalue
  435.                 set prop($p) $propvalue
  436.                 break
  437.             }
  438.         }
  439.         if {$i < [llength $value]} {set value [lreplace $value $i $i]}
  440.     }
  441.     if {[llength $value]} {lappend errorText "$group: $value"}
  442. }
  443.  
  444. proc css::ExpandPileIfBoth {group value pv err} {
  445.     upvar $pv prop $err errorText
  446.     if {[llength $value] == 1} {lappend value $value}
  447.     css::ExpandPile $group $value prop errorText
  448. }
  449.  
  450. proc css::ExpandBorder {group value pv err} {
  451.     upvar $pv prop $err errorText
  452.     global css::Group
  453.     css::ExpandPile $group $value prop errorText
  454.     foreach p [set css::Group($group)] {
  455.         if {[info exists prop($p)]} {
  456.             regsub -- "-top-" $p "-" p1
  457.             set prop($p1) $prop($p)
  458.             unset prop($p)
  459.         }
  460.     }
  461. }
  462.  
  463. proc css::ExpandURL {group value pv err urlprop {ignore ""}} {
  464.     upvar $pv prop $err errorText
  465.     if {[regexp -nocase -indices {url\([ \t\r\n]*("[^"]+"|'[^']+'|[^ \t\n\r\)]+)[ \t\r\n]*\)} $value uv]} {
  466.         set prop($urlprop) [string range $value [lindex $uv 0] [lindex $uv 1]]
  467.         set value "[string range $value 0 [expr {[lindex $uv 0] - 1}]][string range $value [expr {[lindex $uv 1] + 1}] end]"
  468.         css::ExpandPile $group $value prop errorText [concat $urlprop $ignore]
  469.     } else {
  470.         css::ExpandPile $group $value prop errorText $ignore
  471.     }
  472. }
  473.  
  474. proc css::ExpandListStyle {group value pv err} {
  475.     upvar $pv prop $err errorText
  476.     css::ExpandURL $group $value prop errorText list-style-image
  477. }
  478.  
  479. proc css::ExpandCue {group value pv err} {
  480.     upvar $pv prop $err errorText
  481.     set exp {url\([ \t\r\n]*("[^"]+"|'[^']+'|[^ \t\n\r\)]+)[ \t\r\n]*\)}
  482.     regsub -all -nocase $exp $value "\{\\0\}" value
  483.     css::ExpandPileIfBoth $group $value prop errorText
  484. }
  485.  
  486. proc css::ExpandFont {group value pv err} {
  487.     upvar $pv prop $err errorText
  488.     global css::Choices
  489.     regexp {[^ \t]+(,[ \t]*[^ \t]+)*[ \t]*$} $value family
  490.     set value [string range $value 0 [expr {[string length $value] - [string length $family] - 1}]]
  491.     set prop(font-family) [string trim $family]
  492.     set fontsize [string tolower [lindex $value end]]
  493.     set lineheight ""
  494.     regexp {^([^/]+)/?(.*)$} $fontsize "" fontsize lineheight
  495.     if {[lcontains css::Choices(font-size) $fontsize] || ![catch {css::CheckNumber font-size length $fontsize "" 1 0 0}]} {
  496.         set prop(font-size) $fontsize
  497.     }
  498.     if {[lcontains css::Choices(line-height) $lineheight] || ![catch {css::CheckNumber line-height length $lineheight " " 1 1 0}]} {
  499.         set prop(line-height) $lineheight
  500.     }
  501.     set value [lrange $value 0 [expr {[llength $value] - 2}]]
  502.     if {[regsub -all "normal" $value "" value]} {
  503.         set prop(font-style) normal
  504.         set prop(font-variant) normal
  505.         set prop(font-weight) normal
  506.     }
  507.     css::ExpandPile $group $value prop errorText {font-family font-size line-height}
  508. }
  509.  
  510. proc css::ExpandBackground {group value pv err} {
  511.     upvar $pv prop $err errorText
  512.     
  513.     foreach bp [list {top center bottom} {left center right}] {
  514.         set nv ""
  515.         foreach v $value {
  516.             if {[lcontains bp $v]} {
  517.                 lappend prop(background-position) $v
  518.             } else {
  519.                 lappend nv $v
  520.             }
  521.         }
  522.         set value $nv
  523.     }
  524.     set nv ""
  525.     foreach v $value {
  526.         if {![catch {css::CheckNumber background-position length $v "" 1 0 0} v1]} {
  527.             lappend prop(background-position) $v1
  528.         } else {
  529.             lappend nv $v
  530.         }
  531.     }
  532.     set value $nv
  533.     css::ExpandURL $group $value prop errorText background-image background-position
  534. }
  535.  
  536.  
  537. #===============================================================================
  538. # ◊◊◊◊ Button actions ◊◊◊◊ #
  539. #===============================================================================
  540.  
  541. proc css::ColorButton {v index} {
  542.     upvar $v val
  543.     if {[set newColor [html::AddANewColor]] != ""} {
  544.         if {[string index $newColor 0] == "#"} {
  545.             set val [lreplace $val [incr index -2] $index "$newColor"]
  546.         } else {
  547.             set val [lreplace $val [incr index -1] $index "$newColor"]
  548.         }
  549.     }
  550. }
  551.  
  552. proc css::FileButton {v index} {
  553.     upvar $v val
  554.     if {[set newFile [html::GetFile]] != ""} {
  555.         set val [lreplace $val [incr index -1] $index [lindex $newFile 0]]
  556.     }
  557. }
  558.  
  559. proc css::FamilyAddButton {v index} {
  560.     upvar $v val
  561.     if {[set f [lindex $val [expr {$index - 2}]]] != "inherit" && $f != " "} {
  562.         set fm [string trim [join [list [lindex $val [expr {$index - 1}]] $f] ", "] ", "]
  563.         set val [lreplace $val [expr {$index - 2}] [expr {$index - 1}] " " $fm]
  564.     }    
  565. }
  566.  
  567. proc css::ContentAddButton {v index} {
  568.     upvar $v val
  569.     if {[set f [lindex $val [expr {$index - 2}]]] != "inherit" && $f != " "} {
  570.         set fm [string trim [join [list [lindex $val [expr {$index - 1}]] $f] " "]]
  571.         set val [lreplace $val [expr {$index - 2}] [expr {$index - 1}] " " $fm]
  572.     }    
  573. }
  574.  
  575. proc css::QuotesAddButton {v index} {
  576.     upvar $v val
  577.     set q1 [string trim [lindex $val [incr index -2]]]
  578.     set q2 [string trim [lindex $val [incr index]]]
  579.     if {$q1 == "" || $q2 == ""} {
  580.         alertnote "Both the opening and closing quote strings must be specified."
  581.         return
  582.     }
  583.     set q1 [css::QuoteValue $q1]
  584.     set q2 [css::QuoteValue $q2]
  585.     set val [lreplace $val [incr index -1] [incr index 3] "" "" 0 "[lindex $val $index] $q1 $q2"]
  586. }
  587.  
  588. proc css::URLButton {v index} {
  589.     upvar $v val0
  590.     set val {0 0}
  591.     while {1} {
  592.         set box ""
  593.         set ind 2
  594.         set hpos 10
  595.         set wp 10
  596.         css::UrlBox val box hpos wp ind bt ba
  597.         set val [eval [concat dialog -w 460 -h [expr {$hpos + 50}] \
  598.           -b OK 20 [expr {$hpos + 20}]  85 [expr {$hpos + 40}] \
  599.           -b Cancel 110 [expr {$hpos + 20}] 175 [expr {$hpos + 40}] $box]]
  600.         # OK clicked?
  601.         if {[lindex $val 0]} {break}
  602.         # Cancel clicked?
  603.         if {[lindex $val 1]} {return}
  604.         css::FileButton val $bt
  605.     }
  606.     set ind 2
  607.     set val0 [lreplace $val0 [expr {$index - 2}] [expr {$index - 2}] [string trim "[lindex $val0 [expr {$index - 2}]][css::ReadUrl val ind]"]]
  608. }
  609.  
  610. proc css::CounterButton {v index} {
  611.     upvar $v val0
  612.     global css::Choices
  613.     set val {0 0}
  614.     while {1} {
  615.         set box "-t counter 100 10 180 30 \
  616.           -t name: 10 40 80 55 -e [list [lindex $val 2]] 90 40 250 55 \
  617.           -t style: 10 70 80 85 -m {[list [lindex $val 3]] { } [set css::Choices(list-style-type)]} 90 70 250 90"
  618.         set val [eval [concat dialog -w 260 -h 130 -b OK 20 100 85 120 \
  619.           -b Cancel 110 100 175 120 $box]]
  620.         # Cancel clicked?
  621.         if {[lindex $val 1]} {return}
  622.         if {[set txt [string trim [lindex $val 2]]] == ""} {return}
  623.         if {![regexp {^[^-0-9][^ \t\r\n]*$} $txt]} {
  624.             alertnote "Invalid identifier."
  625.         } else {
  626.             break
  627.         }
  628.     }
  629.     if {[lindex $val 3] != " "} {append txt ", " [lindex $val 3]}
  630.     set val0 [lreplace $val0 [expr {$index - 3}] [expr {$index - 3}] [string trim "[lindex $val0 [expr {$index - 3}]] counter($txt)"]]
  631. }
  632.  
  633. proc css::CountersButton {v index} {
  634.     upvar $v val0
  635.     global css::Choices
  636.     set val {0 0}
  637.     while {1} {
  638.         set box "-t counters 100 10 180 30  \
  639.           -t name: 10 40 80 55 -e [list [lindex $val 2]] 90 40 250 55 \
  640.           -t string: 10 70 80 85 -e [list [lindex $val 3]]  90 70 250 85 \
  641.           -t style: 10 100 80 115 -m {[list [lindex $val 4]] { } [set css::Choices(list-style-type)]} 90 100 250 120"
  642.         set val [eval [concat dialog -w 260 -h 160 -b OK 20 130 85 150 \
  643.           -b Cancel 110 130 175 150 $box]]
  644.         # Cancel clicked?
  645.         if {[lindex $val 1]} {return}
  646.         if {[set txt [string trim [lindex $val 2]]] == "" || [set txt2 [string trim [lindex $val 3]]] == ""} {return}
  647.         if {![regexp {^[^-0-9][^ \t\r\n]*$} $txt]} {
  648.             alertnote "Invalid identifier."
  649.         } else {
  650.             break
  651.         }
  652.     }
  653.     set txt2 [css::QuoteValue $txt2]
  654.     append txt ", $txt2"
  655.     if {[lindex $val 4] != " "} {append txt ", " [lindex $val 4]}
  656.     set val0 [lreplace $val0 [expr {$index - 4}] [expr {$index - 4}] [string trim "[lindex $val0 [expr {$index - 4}]] counters($txt)"]]
  657. }
  658.  
  659. proc css::AttrButton {v index} {
  660.     upvar $v val0
  661.     set box "-t attr 10 10 80 30 -e {} 90 10 250 25"
  662.     set val [eval [concat dialog -w 460 -h 70 -b OK 20 40 85 60 \
  663.       -b Cancel 110 40 175 60 $box]]
  664.     # Cancel clicked?
  665.     if {[lindex $val 1]} {return}
  666.     if {[set txt [string trim [lindex $val 2]]] == ""} {return}
  667.     set val0 [lreplace $val0 [expr {$index - 5}] [expr {$index - 5}] [string trim "[lindex $val0 [expr {$index - 5}]] attr($txt)"]]
  668. }
  669.  
  670. proc css::AddTextShadow {v index} {
  671.     upvar $v val
  672.     set errtext ""
  673.     incr index -9
  674.     foreach item {horizontal vertical blur} {
  675.         set $item [css::ReadNumber $item val index length 0 0 0 errtext]
  676.     }
  677.     if {$horizontal == "" || $vertical == ""} {
  678.         alertnote "Both a horizontal and vertical value must be specified."
  679.         return
  680.     }
  681.     set txt "$horizontal$vertical$blur"
  682.     append txt [css::ReadColor color val index errtext]
  683.     if {$errtext != ""} {
  684.         html::ErrorWindow "Invalid input" $errtext
  685.     } else {
  686.         incr index
  687.         set val [lreplace $val $index $index [string trim "[lindex $val $index], $txt" ", "]]
  688.         set val [lreplace $val [expr {$index - 10}] [expr {$index - 3}] "" "" "" "" "" "" "" " "]
  689.     }
  690. }
  691.  
  692. proc css::SrcButton {v index} {
  693.     upvar $v val
  694.     set turl [string trim [lindex $val [incr index -5]]]
  695.     set murl [lindex $val [incr index]]
  696.     set format [string trim [lindex $val [incr index 2]]]
  697.     set face [string trim [lindex $val [incr index]]]
  698.     set url ""
  699.     if {[set u $turl] != "" || [set u $murl] != " "} {set url $u}
  700.     if {$url != "" && $format != ""} {
  701.         if {![regexp {^("[^"]+"|'[^']+')([ \t\r\n]*,[ \t\r\n]("[^"]+"|'[^']+'))*$} $format]} {
  702.             alertnote "Format should be a list of comma separated strings."
  703.         } else {
  704.             set i $index
  705.             set val [lreplace $val [incr i 2] $i [string trimleft [join [list [lindex $val $i] "url(\"$url\") format($format)"] ", "] ", "]]
  706.             set val [lreplace $val [incr i -6] [incr i 3] "" " " 0 ""]
  707.         }
  708.     }
  709.     if {$face != ""} {
  710.         set val [lreplace $val [incr index 2] $index [string trimleft [join [list [lindex $val $index] "local(\"$face\")"] ", "] ", "]]
  711.         set val [lreplace $val [incr index -2] $index ""]
  712.     }
  713. }
  714.  
  715. proc css::CursorAddButton {v index} {
  716.     upvar $v val
  717.     incr index -4 
  718.     if {[set url [css::ReadUrl val index]] != ""} {
  719.         set val [lreplace $val [expr {$index - 3}] $index "" " " 0 [string trimleft [join [list [lindex $val $index] $url] ", "] ", "]]
  720.     }
  721. }
  722.  
  723. #===============================================================================
  724. # ◊◊◊◊ Checking dialog values ◊◊◊◊ #
  725. #===============================================================================
  726.  
  727. # Check if a color number is a valid number, or one of the predefined names.
  728. proc css::CheckColorNumber {color} {
  729.     global html::ColorName css::Colors html::userColors
  730.     if {[info exists html::ColorName($color)]} {return $color}
  731.     if {[info exists html::userColors($color)]} {return [set html::userColors($color)]}
  732.     set color [string tolower $color]
  733.     if {[set i [lsearch -exact [string tolower ${css::Colors}] $color]] >= 0} {
  734.         return [lindex ${css::Colors} $i]
  735.     }
  736.     # rgb(1,2,3)
  737.     if {[regexp {^rgb\(([0-9]+),([0-9]+),([0-9]+)\)$} $color dum c1 c2 c3]} {
  738.         if {$c1 > -1 && $c1 < 256 && $c2 > -1 && $c2 < 256 && $c3 > -1 && $c3 < 256} {
  739.             return $color
  740.         } else {
  741.             error "Invalid color."
  742.         }
  743.     }
  744.     # rgb(1.0%,2.0%,3.0%)
  745.     if {[regexp {^rgb\(([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%\)$} $color dum c1 c2 c3]} {
  746.         if {$c1 >= 0.0 && $c1 <= 100.0 && $c2 >= 0.0 && $c2 <= 100.0 && $c3 >= 0.0 && $c3 <= 100.0} {
  747.             return $color
  748.         } else {
  749.             error "Invalid color."
  750.         }
  751.     }
  752.         
  753.     # #123456 or #123
  754.     if {[string index $color 0] != "#"} {
  755.         set color "#${color}"
  756.     }
  757.     set color [string toupper $color]
  758.     if {([string length $color] != 7 && [string length $color] != 4) || ![regexp {^#[0-9A-F]+$} $color]} {
  759.         error "Invalid color."
  760.     } else {
  761.         return $color
  762.     }    
  763. }
  764.  
  765. # Check if a CSS number is ok.
  766. proc css::CheckNumber {prop type num unit percent number integer} {
  767.     global css::Units css::Range
  768.     if {![regexp {^([-\+]?[0-9]+\.?[0-9]*)([%a-zA-Z]*)$} $num d n u]} {
  769.         error "Invalid number, $num."
  770.     }
  771.     if {$integer && [regexp {\.} $n]} {
  772.         error "Integer required, $num."
  773.     }
  774.     if {$u != ""} {set unit $u}
  775.     set allowedUnits ""
  776.     if {$type != ""} {set allowedUnits [set css::Units($type)]}
  777.     if {$percent} {lappend allowedUnits %}
  778.     if {$number} {lappend allowedUnits " "}
  779.     if {[set w [lsearch -exact [string tolower $allowedUnits] [string tolower $unit]]] < 0} {
  780.         if {$number && [llength $allowedUnits] == 1} {error "Invalid number, $num."}
  781.         error "Invalid unit, $num."
  782.     }
  783.     regexp {([^:]*):(.*)} [set css::Range($prop)] "" min max
  784.     if {$min != "-i" && $n < $min} {error "Value must be greater than or equal to $min."}
  785.     if {$max != "i" && $n > $max} {error "Value must be less than or equal to $min."}
  786.     set unit [lindex $allowedUnits $w]
  787.     if {$unit == " "} {set unit ""}
  788.     return "$n$unit"
  789. }
  790.  
  791. proc css::CheckUrange {urange} {
  792.     return [regexp {^U\+([0-9A-F\?]+|[0-9A-F]+-[0-9A-F]+)$} $urange]
  793. }
  794.